home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclUnixTest.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  12.5 KB  |  430 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclUnixTest.c --
  3.  *
  4.  *    Contains platform specific test commands for the Unix platform.
  5.  *
  6.  * Copyright (c) 1996 Sun Microsystems, Inc.
  7.  *
  8.  * See the file "license.terms" for information on usage and redistribution
  9.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  *
  11.  * SCCS: @(#) tclUnixTest.c 1.4 97/05/14 13:24:29
  12.  */
  13.  
  14. #include "tclInt.h"
  15. #include "tclPort.h"
  16.  
  17. /*
  18.  * The following macros convert between TclFile's and fd's.  The conversion
  19.  * simple involves shifting fd's up by one to ensure that no valid fd is ever
  20.  * the same as NULL.  Note that this code is duplicated from tclUnixPipe.c
  21.  */
  22.  
  23. #define MakeFile(fd) ((TclFile)((fd)+1))
  24. #define GetFd(file) (((int)file)-1)
  25.  
  26. /*
  27.  * The stuff below is used to keep track of file handlers created and
  28.  * exercised by the "testfilehandler" command.
  29.  */
  30.  
  31. typedef struct Pipe {
  32.     TclFile readFile;        /* File handle for reading from the
  33.                  * pipe.  NULL means pipe doesn't exist yet. */
  34.     TclFile writeFile;        /* File handle for writing from the
  35.                  * pipe. */
  36.     int readCount;        /* Number of times the file handler for
  37.                  * this file has triggered and the file
  38.                  * was readable. */
  39.     int writeCount;        /* Number of times the file handler for
  40.                  * this file has triggered and the file
  41.                  * was writable. */
  42. } Pipe;
  43.  
  44. #define MAX_PIPES 10
  45. static Pipe testPipes[MAX_PIPES];
  46.  
  47. /*
  48.  * Forward declarations of procedures defined later in this file:
  49.  */
  50.  
  51. static void        TestFileHandlerProc _ANSI_ARGS_((ClientData clientData,
  52.                 int mask));
  53. static int        TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy,
  54.                 Tcl_Interp *interp, int argc, char **argv));
  55. static int        TestfilewaitCmd _ANSI_ARGS_((ClientData dummy,
  56.                 Tcl_Interp *interp, int argc, char **argv));
  57. static int        TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy,
  58.                 Tcl_Interp *interp, int argc, char **argv));
  59. int            TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp));
  60.  
  61. /*
  62.  *----------------------------------------------------------------------
  63.  *
  64.  * TclplatformtestInit --
  65.  *
  66.  *    Defines commands that test platform specific functionality for
  67.  *    Unix platforms.
  68.  *
  69.  * Results:
  70.  *    A standard Tcl result.
  71.  *
  72.  * Side effects:
  73.  *    Defines new commands.
  74.  *
  75.  *----------------------------------------------------------------------
  76.  */
  77.  
  78. int
  79. TclplatformtestInit(interp)
  80.     Tcl_Interp *interp;        /* Interpreter to add commands to. */
  81. {
  82.     Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
  83.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  84.     Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
  85.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  86.     Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
  87.             (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
  88.     return TCL_OK;
  89. }
  90.  
  91. /*
  92.  *----------------------------------------------------------------------
  93.  *
  94.  * TestfilehandlerCmd --
  95.  *
  96.  *    This procedure implements the "testfilehandler" command. It is
  97.  *    used to test Tcl_CreateFileHandler, Tcl_DeleteFileHandler, and
  98.  *    TclWaitForFile.
  99.  *
  100.  * Results:
  101.  *    A standard Tcl result.
  102.  *
  103.  * Side effects:
  104.  *    None.
  105.  *
  106.  *----------------------------------------------------------------------
  107.  */
  108.  
  109. static int
  110. TestfilehandlerCmd(clientData, interp, argc, argv)
  111.     ClientData clientData;        /* Not used. */
  112.     Tcl_Interp *interp;            /* Current interpreter. */
  113.     int argc;                /* Number of arguments. */
  114.     char **argv;            /* Argument strings. */
  115. {
  116.     Pipe *pipePtr;
  117.     int i, mask, timeout;
  118.     static int initialized = 0;
  119.     char buffer[4000];
  120.     TclFile file;
  121.  
  122.     /*
  123.      * NOTE: When we make this code work on Windows also, the following
  124.      * variable needs to be made Unix-only.
  125.      */
  126.     
  127.     if (!initialized) {
  128.     for (i = 0; i < MAX_PIPES; i++) {
  129.         testPipes[i].readFile = NULL;
  130.     }
  131.     initialized = 1;
  132.     }
  133.  
  134.     if (argc < 2) {
  135.     Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
  136.                 " option ... \"", (char *) NULL);
  137.         return TCL_ERROR;
  138.     }
  139.     pipePtr = NULL;
  140.     if (argc >= 3) {
  141.     if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
  142.         return TCL_ERROR;
  143.     }
  144.     if (i >= MAX_PIPES) {
  145.         Tcl_AppendResult(interp, "bad index ", argv[2], (char *) NULL);
  146.         return TCL_ERROR;
  147.     }
  148.     pipePtr = &testPipes[i];
  149.     }
  150.  
  151.     if (strcmp(argv[1], "close") == 0) {
  152.     for (i = 0; i < MAX_PIPES; i++) {
  153.         if (testPipes[i].readFile != NULL) {
  154.         TclpCloseFile(testPipes[i].readFile);
  155.         testPipes[i].readFile = NULL;
  156.         TclpCloseFile(testPipes[i].writeFile);
  157.         testPipes[i].writeFile = NULL;
  158.         }
  159.     }
  160.     } else if (strcmp(argv[1], "clear") == 0) {
  161.     if (argc != 3) {
  162.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  163.                     argv[0], " clear index\"", (char *) NULL);
  164.         return TCL_ERROR;
  165.     }
  166.     pipePtr->readCount = pipePtr->writeCount = 0;
  167.     } else if (strcmp(argv[1], "counts") == 0) {
  168.     char buf[30];
  169.     
  170.     if (argc != 3) {
  171.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  172.                     argv[0], " counts index\"", (char *) NULL);
  173.         return TCL_ERROR;
  174.     }
  175.     sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
  176.     Tcl_SetResult(interp, buf, TCL_VOLATILE);
  177.     } else if (strcmp(argv[1], "create") == 0) {
  178.     if (argc != 5) {
  179.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  180.                     argv[0], " create index readMode writeMode\"",
  181.                     (char *) NULL);
  182.         return TCL_ERROR;
  183.     }
  184.     if (pipePtr->readFile == NULL) {
  185.         if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
  186.         Tcl_AppendResult(interp, "couldn't open pipe: ",
  187.             Tcl_PosixError(interp), (char *) NULL);
  188.         return TCL_ERROR;
  189.         }
  190. #ifdef O_NONBLOCK
  191.         fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
  192.         fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
  193. #else
  194.         Tcl_SetResult(interp, "can't make pipes non-blocking",
  195.             TCL_STATIC);
  196.         return TCL_ERROR;
  197. #endif
  198.     }
  199.     pipePtr->readCount = 0;
  200.     pipePtr->writeCount = 0;
  201.  
  202.     if (strcmp(argv[3], "readable") == 0) {
  203.         Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
  204.             TestFileHandlerProc, (ClientData) pipePtr);
  205.     } else if (strcmp(argv[3], "off") == 0) {
  206.         Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
  207.     } else if (strcmp(argv[3], "disabled") == 0) {
  208.         Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
  209.             TestFileHandlerProc, (ClientData) pipePtr);
  210.     } else {
  211.         Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"",
  212.             (char *) NULL);
  213.         return TCL_ERROR;
  214.     }
  215.     if (strcmp(argv[4], "writable") == 0) {
  216.         Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
  217.             TestFileHandlerProc, (ClientData) pipePtr);
  218.     } else if (strcmp(argv[4], "off") == 0) {
  219.         Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
  220.     } else if (strcmp(argv[4], "disabled") == 0) {
  221.         Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
  222.             TestFileHandlerProc, (ClientData) pipePtr);
  223.     } else {
  224.         Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"",
  225.             (char *) NULL);
  226.         return TCL_ERROR;
  227.     }
  228.     } else if (strcmp(argv[1], "empty") == 0) {
  229.     if (argc != 3) {
  230.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  231.                     argv[0], " empty index\"", (char *) NULL);
  232.         return TCL_ERROR;
  233.     }
  234.  
  235.         while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
  236.             /* Empty loop body. */
  237.         }
  238.     } else if (strcmp(argv[1], "fill") == 0) {
  239.     if (argc != 3) {
  240.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  241.                     argv[0], " empty index\"", (char *) NULL);
  242.         return TCL_ERROR;
  243.     }
  244.  
  245.     memset((VOID *) buffer, 'a', 4000);
  246.         while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
  247.             /* Empty loop body. */
  248.         }
  249.     } else if (strcmp(argv[1], "fillpartial") == 0) {
  250.     char buf[30];
  251.     
  252.     if (argc != 3) {
  253.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  254.                     argv[0], " empty index\"", (char *) NULL);
  255.         return TCL_ERROR;
  256.     }
  257.  
  258.     memset((VOID *) buffer, 'b', 10);
  259.     sprintf(buf, "%d", write(GetFd(pipePtr->writeFile), buffer, 10));
  260.     Tcl_SetResult(interp, buf, TCL_VOLATILE);
  261.     } else if (strcmp(argv[1], "oneevent") == 0) {
  262.     Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
  263.     } else if (strcmp(argv[1], "wait") == 0) {
  264.     if (argc != 5) {
  265.         Tcl_AppendResult(interp, "wrong # arguments: should be \"",
  266.                     argv[0], " wait index readable/writable timeout\"",
  267.                     (char *) NULL);
  268.         return TCL_ERROR;
  269.     }
  270.     if (pipePtr->readFile == NULL) {
  271.         Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist",
  272.             (char *) NULL);
  273.         return TCL_ERROR;
  274.     }
  275.     if (strcmp(argv[3], "readable") == 0) {
  276.         mask = TCL_READABLE;
  277.         file = pipePtr->readFile;
  278.     } else {
  279.         mask = TCL_WRITABLE;
  280.         file = pipePtr->writeFile;
  281.     }
  282.     if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
  283.         return TCL_ERROR;
  284.     }
  285.     i = TclUnixWaitForFile(GetFd(file), mask, timeout);
  286.     if (i & TCL_READABLE) {
  287.         Tcl_AppendElement(interp, "readable");
  288.     }
  289.     if (i & TCL_WRITABLE) {
  290.         Tcl_AppendElement(interp, "writable");
  291.     }
  292.     } else if (strcmp(argv[1], "windowevent") == 0) {
  293.     Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
  294.     } else {
  295.     Tcl_AppendResult(interp, "bad option \"", argv[1],
  296.         "\": must be close, clear, counts, create, empty, fill, ",
  297.         "fillpartial, oneevent, wait, or windowevent",
  298.         (char *) NULL);
  299.     return TCL_ERROR;
  300.     }
  301.     return TCL_OK;
  302. }
  303.  
  304. static void TestFileHandlerProc(clientData, mask)
  305.     ClientData clientData;    /* Points to a Pipe structure. */
  306.     int mask;            /* Indicates which events happened:
  307.                  * TCL_READABLE or TCL_WRITABLE. */
  308. {
  309.     Pipe *pipePtr = (Pipe *) clientData;
  310.  
  311.     if (mask & TCL_READABLE) {
  312.     pipePtr->readCount++;
  313.     }
  314.     if (mask & TCL_WRITABLE) {
  315.     pipePtr->writeCount++;
  316.     }
  317. }
  318.  
  319. /*
  320.  *----------------------------------------------------------------------
  321.  *
  322.  * TestfilewaitCmd --
  323.  *
  324.  *    This procedure implements the "testfilewait" command. It is
  325.  *    used to test TclUnixWaitForFile.
  326.  *
  327.  * Results:
  328.  *    A standard Tcl result.
  329.  *
  330.  * Side effects:
  331.  *    None.
  332.  *
  333.  *----------------------------------------------------------------------
  334.  */
  335.  
  336. static int
  337. TestfilewaitCmd(clientData, interp, argc, argv)
  338.     ClientData clientData;        /* Not used. */
  339.     Tcl_Interp *interp;            /* Current interpreter. */
  340.     int argc;                /* Number of arguments. */
  341.     char **argv;            /* Argument strings. */
  342. {
  343.     int mask, result, timeout;
  344.     Tcl_Channel channel;
  345.     int fd;
  346.  
  347.     if (argc != 4) {
  348.     Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
  349.         " file readable|writable|both timeout\"", (char *) NULL);
  350.     return TCL_ERROR;
  351.     }
  352.     channel = Tcl_GetChannel(interp, argv[1], NULL);
  353.     if (channel == NULL) {
  354.     return TCL_ERROR;
  355.     }
  356.     if (strcmp(argv[2], "readable") == 0) {
  357.     mask = TCL_READABLE;
  358.     } else if (strcmp(argv[2], "writable") == 0){
  359.     mask = TCL_WRITABLE;
  360.     } else if (strcmp(argv[2], "both") == 0){
  361.     mask = TCL_WRITABLE|TCL_READABLE;
  362.     } else {
  363.     Tcl_AppendResult(interp, "bad argument \"", argv[2],
  364.         "\": must be readable, writable, or both", (char *) NULL);
  365.     return TCL_ERROR;
  366.     }
  367.     if (Tcl_GetChannelHandle(channel, 
  368.         (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
  369.         (ClientData*) &fd) != TCL_OK) {
  370.     Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
  371.     return TCL_ERROR;
  372.     }
  373.     if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
  374.     return TCL_ERROR;
  375.     }
  376.     result = TclUnixWaitForFile(fd, mask, timeout);
  377.     if (result & TCL_READABLE) {
  378.     Tcl_AppendElement(interp, "readable");
  379.     }
  380.     if (result & TCL_WRITABLE) {
  381.     Tcl_AppendElement(interp, "writable");
  382.     }
  383.     return TCL_OK;
  384. }
  385.  
  386. /*
  387.  *----------------------------------------------------------------------
  388.  *
  389.  * TestgetopenfileCmd --
  390.  *
  391.  *    This procedure implements the "testgetopenfile" command. It is
  392.  *    used to get a FILE * value from a registered channel.
  393.  *
  394.  * Results:
  395.  *    A standard Tcl result.
  396.  *
  397.  * Side effects:
  398.  *    None.
  399.  *
  400.  *----------------------------------------------------------------------
  401.  */
  402.  
  403. static int
  404. TestgetopenfileCmd(clientData, interp, argc, argv)
  405.     ClientData clientData;        /* Not used. */
  406.     Tcl_Interp *interp;            /* Current interpreter. */
  407.     int argc;                /* Number of arguments. */
  408.     char **argv;            /* Argument strings. */
  409. {
  410.     ClientData filePtr;
  411.  
  412.     if (argc != 3) {
  413.         Tcl_AppendResult(interp,
  414.                 "wrong # args: should be \"", argv[0],
  415.                 " channelName forWriting\"",
  416.                 (char *) NULL);
  417.         return TCL_ERROR;
  418.     }
  419.     if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
  420.             == TCL_ERROR) {
  421.         return TCL_ERROR;
  422.     }
  423.     if (filePtr == (ClientData) NULL) {
  424.         Tcl_AppendResult(interp,
  425.                 "Tcl_GetOpenFile succeeded but FILE * NULL!", (char *) NULL);
  426.         return TCL_ERROR;
  427.     }
  428.     return TCL_OK;
  429. }
  430.